home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / GRAPHICS / FADE2.ZIP / FADE2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-11-26  |  2.1 KB  |  106 lines
  1. UNIT Fade2;
  2.  
  3. INTERFACE
  4.  
  5.    PROCEDURE FadeOut;
  6.    PROCEDURE ResetTextMode;
  7.    PROCEDURE GrabPal;
  8.    PROCEDURE BlackOut;
  9.    PROCEDURE FadeIn;
  10.  
  11. IMPLEMENTATION
  12.  
  13. VAR Pall,Pall2 : Array[0..255,1..3] of Byte;
  14.  
  15. PROCEDURE wrt; assembler;
  16. label
  17.   l1, l2;
  18. asm
  19.     mov dx,3DAh
  20. l1:
  21.     in al,dx
  22.     and al,08h
  23.     jnz l1
  24. l2:
  25.     in al,dx
  26.     and al,08h
  27.     jz  l2
  28. end;
  29.  
  30. PROCEDURE gp(ColorNo : Byte; Var R,G,B : Byte);
  31. Begin
  32.    Port[$3c7] := ColorNo;
  33.    R := Port[$3c9];
  34.    G := Port[$3c9];
  35.    B := Port[$3c9];
  36. End;
  37.  
  38. PROCEDURE ResetTextMode;
  39. BEGIN
  40.   asm
  41.      mov        ax,03h
  42.      int        10h
  43.   end;
  44. END;
  45.  
  46. PROCEDURE sp(ColorNo : Byte; R,G,B : Byte);
  47. BEGIN
  48.    Port[$3c8] := ColorNo;
  49.    Port[$3c9] := R;
  50.    Port[$3c9] := G;
  51.    Port[$3c9] := B;
  52. END;
  53.  
  54. PROCEDURE FadeOut;
  55. VAR lxpy1,lxpy2:integer;
  56.     Tmp : Array [1..3] of byte;
  57. BEGIN
  58.   For lxpy1:=1 to 64 do BEGIN
  59.     wrt;
  60.     For lxpy2:=1 to 255 do BEGIN
  61.       gp (lxpy2,Tmp[1],Tmp[2],Tmp[3]);
  62.       If Tmp[1]>0 then dec (Tmp[1]);
  63.       If Tmp[2]>0 then dec (Tmp[2]);
  64.       If Tmp[3]>0 then dec (Tmp[3]);
  65.       sp (lxpy2,Tmp[1],Tmp[2],Tmp[3]);
  66.     END;
  67.   END;
  68. END;
  69.  
  70. {──────────────────────────────────────────────────────────────────────────}
  71. Procedure GrabPal;
  72. VAR loop1:integer;
  73. BEGIN
  74.   For loop1:=0 to 255 do
  75.     Gp (loop1,pall2[loop1,1],pall2[loop1,2],pall2[loop1,3]);
  76. END;
  77. {──────────────────────────────────────────────────────────────────────────}
  78. Procedure Blackout;
  79.   { This procedure blackens the screen by setting the pallette values of
  80.     all the colors to zero. }
  81. VAR loop1:integer;
  82. BEGIN
  83.   WRt;
  84.   For loop1:=0 to 255 do
  85.     sP (loop1,0,0,0);
  86. END;
  87.  
  88.  
  89. Procedure FadeIn;
  90. Var loop1,loop2:integer;
  91.     Tmp : Array [1..3] of byte;
  92. BEGIN
  93.   For loop1:=1 to 64 do BEGIN
  94.   WRt;
  95.   For loop2:=0 to 255 do
  96.    BEGIN
  97.       Gp (loop2,Tmp[1],Tmp[2],Tmp[3]);
  98.       If Tmp[1]<Pall2[loop2,1] then inc (Tmp[1]);
  99.       If Tmp[2]<Pall2[loop2,2] then inc (Tmp[2]);
  100.       If Tmp[3]<Pall2[loop2,3] then inc (Tmp[3]);
  101.       sP (loop2,Tmp[1],Tmp[2],Tmp[3]);
  102.     END;
  103.   END;
  104. END;
  105.  
  106. END.